Power Tools for Macintosh/Power Tools for Macintosh (SoftBit)(1992).iso/Stacks/*F-I/HyperCard Utilities/Videodisc⁄Drivers ƒ/HitachiVideo.p

Text File | 1986-11-11 | 7.0 KB | 296 lines | [TEXT/MPS ]

{$R-}
{$D+}
(*
    HitachiVideo -- a WildCard user-defined command to drive a laser disc player.

    To compile and link this file using Macintosh Programmer's Workshop,

    pascal HitachiVideo.p
    link -o WildCommands -sn Main=HitachiVideo -sn STDIO=HitachiVideo ∂
         -sn INTENV=HitachiVideo -rt WCMD=2 ∂
         HitachiVideo.p.o {MPW}libraries:interface.o

    then use ResEdit to copy the resulting WCMD from WildCommands
    and paste it into WildCard, the Home stack, or your own stack.
    (WCMD=1 Panasonic, =2 Hitachi, =3 Phillips, =4 PioneerLDV6000)
*)

UNIT DummyUnit;

INTERFACE

   USES MemTypes, QuickDraw, OsIntf;

IMPLEMENTATION

PROCEDURE Hitachi(commandPtr: Ptr);                            FORWARD;

   PROCEDURE EntryPoint(arg: Ptr);
   { entry point cannot have local procs, but forward routines can }
   BEGIN
     Hitachi(arg);
   END;

   PROCEDURE Hitachi(commandPtr: Ptr);
   VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
       message, tempStr: Str255;
       refNum: INTEGER;
       err: INTEGER;

     PROCEDURE OpenSerial;
     VAR handShake: SerShk;
         baudRate: INTEGER;
     BEGIN
       baudRate := 9600;
       { for now, use modem port so we don't mess with AppleTalk }
       err := FSOpen('.AOUT',0,refNum);
       IF err = 0 THEN
         BEGIN
           WITH handShake DO
             BEGIN
               fXon := 1;
               fCTS := 1;
               xon  := CHR(17);
               xoff := CHR(19);
               errs := 0;
               evts := 0;
               fInx := 0;
             END;
           err := SerHShake(refNum,handShake);
           IF err = 0 THEN
             err := Control(refNum,13,@baudRate);
         END;
     END;


     PROCEDURE CloseSerial;
     BEGIN
       err := FSClose(refNum);
     END;


     PROCEDURE SendCommand(cmd: Str255);
     VAR count: LongInt;
     BEGIN
       count := Length(cmd);
       err := FSWrite(refNum, count, Pointer(Ord(@cmd)+1));
     END;

     FUNCTION Concat(str1, str2, str3: Str255): Str255;
     VAR result: Str255;
         resultLen: INTEGER;
         charNum: INTEGER;
     BEGIN
       result := '';
       resultLen := 0;
       FOR charNum := 1 TO Length(str1) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str1[charNum];
         END;
       FOR charNum := 1 TO Length(str2) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str2[charNum];
         END;
       FOR charNum := 1 TO Length(str3) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str3[charNum];
         END;
      result[0] := CHR(resultLen);
      Concat := result;
     END;


     PROCEDURE GetMessage;
     VAR charNum: INTEGER;
         msgChar: CHAR;
     BEGIN
       { skip command name }
       WHILE (commandPtr^ <> 0) AND (commandPtr^ <> 13) AND (CHR(commandPtr^) <> ' ') DO
         commandPtr := Pointer(Ord(commandPtr)+1);

       { skip following white space }
       WHILE CHR(commandPtr^) = ' ' DO
         commandPtr := Pointer(Ord(commandPtr)+1);

       { extract the rest into a Str255 }
       charNum := 0;
       WHILE (commandPtr^ <> 0) AND (charNum < 255) DO
         BEGIN
           msgChar := CHR(commandPtr^);
           commandPtr := Pointer(Ord(commandPtr)+1);
           charNum := charNum + 1;
           IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
             message[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')))
           ELSE message[charNum] := msgChar;
         END;
       message[0] := CHR(charNum);
     END;


     FUNCTION Contains(target: Str255): BOOLEAN;
     VAR offset: INTEGER;

       FUNCTION Match: BOOLEAN;
       VAR index: INTEGER;
       BEGIN
         Match := TRUE;
         FOR index := 1 TO Length(target) DO
           IF offset + index > Length(message) THEN
             BEGIN
               Match := FALSE;  { ran off the end }
               EXIT(Match);
             END
           ELSE IF target[index] <> message[offset+index] THEN
             BEGIN
               Match := FALSE;  { hit a wrong char }
               EXIT(Match);
             END;
       END;

     BEGIN
       Contains := FALSE;
       FOR offset := 0 TO Length(message) - 1 DO
         IF Match THEN
           BEGIN
             Contains := TRUE;
             EXIT(Contains);
           END;
     END;


     FUNCTION GetDigit(digit: CHAR): Str255;
     BEGIN
       CASE digit OF
         '0': GetDigit := '0'; { this is doing a type conversion }
         '1': GetDigit := '1'; { from CHAR to Str255 }
         '2': GetDigit := '2';
         '3': GetDigit := '3';
         '4': GetDigit := '4';
         '5': GetDigit := '5';
         '6': GetDigit := '6';
         '7': GetDigit := '7';
         '8': GetDigit := '8';
         '9': GetDigit := '9';
       END;
     END;


     FUNCTION GetInteger(which: INTEGER): Str255;
     { get the Nth integer in Hitachi format }
     VAR digitLoc, charVal:    INTEGER;
         intStr:            Str255;
         nowReading:        INTEGER;
         inNumber:            BOOLEAN;
     BEGIN
       intStr := '';
       nowReading := 0;
       inNumber := FALSE;
       FOR digitLoc := 1 TO Length(message) DO
         BEGIN
           charVal := ORD(message[digitLoc]);
           IF which <> nowReading THEN
             BEGIN
               IF (NOT inNumber) AND ((charVal >= ORD('0')) AND (charVal <= ORD('9'))) THEN
                 BEGIN
                   nowReading := nowReading + 1;
                   inNumber := TRUE;
                 END;
               IF (inNumber) AND ((charVal < ORD('0')) OR (charVal > ORD('9'))) THEN
                 inNumber := FALSE;
             END;
           IF nowReading = which THEN
             BEGIN
               {collect our number}
               IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
                 intStr := Concat(intStr, GetDigit(message[digitLoc]), '');
             END;
         END;
       GetInteger := intStr;
       IF Length(intStr) = 0 THEN SysBeep(1);  {warning that right number was not found}
     END;

   BEGIN
     OpenSerial;
     IF err <> 0 THEN
       BEGIN
         SysBeep(1);
         EXIT(Hitachi);
       END;

     GetMessage;

     { set flags }
     reverseFlag := Contains('rev');
     offFlag := Contains('off');
     tillFlag := Contains('till');

     IF Contains('stop') THEN SendCommand('*')
     ELSE IF Contains('init') THEN SendCommand('h')
     ELSE IF Contains('eject') THEN SendCommand('\')
     ELSE IF Contains('search') THEN SendCommand(Concat('+:', GetInteger(1), 'A'))
     ELSE IF Contains('play') THEN
       BEGIN
         IF tillFlag THEN
           BEGIN
             tempStr := Concat('+:', GetInteger(1), '$');
             tempStr := Concat(tempStr, GetInteger(2), 'AA');
             tempStr[Length(tempStr)] := CHR(13);  { cr at end }
             SendCommand(tempStr)
             { Video Play 12345 till 12400  -- this is the proper format }
           END
         ELSE IF reverseFlag THEN SendCommand('B')
         ELSE SendCommand('%'); { normal play forward }
       END
     ELSE IF Contains('step') THEN
       BEGIN
         IF reverseFlag THEN SendCommand(')')
         ELSE SendCommand('$')
       END

     ELSE IF Contains('slow') THEN
       BEGIN
         IF reverseFlag THEN SendCommand('(')
         ELSE SendCommand('#')
       END
     ELSE IF Contains('fast') THEN
       BEGIN
         IF reverseFlag THEN SendCommand('&')
         ELSE SendCommand('!')
       END
     ELSE IF Contains('scan') THEN
       BEGIN
         IF reverseFlag THEN SendCommand('''')
         ELSE SendCommand('"')
       END
     ELSE IF Contains('picture') THEN
       BEGIN
         IF offFlag THEN SendCommand('o')
         ELSE SendCommand('n')
       END
     ELSE IF Contains('frame') THEN
       BEGIN
         IF offFlag THEN SendCommand('M')
         ELSE SendCommand('L')
       END
     ELSE IF Contains('sound') THEN
       BEGIN
         IF Contains('1') THEN
           IF offFlag THEN SendCommand('I')
           ELSE SendCommand('H')
         ELSE IF Contains('2') THEN
           IF offFlag THEN SendCommand('K')
           ELSE SendCommand('J')
         ELSE SysBeep(1);
       END
     ELSE SysBeep(1); { unknown command }
     CloseSerial;
   END;

END.